nstrate the GetImage and PutImage commands } const r = 20; StartX = 100; StartY = 50; var CurPort : ViewPortType; procedure MoveSaucer(var X, Y : integer; Width, Height : integer); var Step : integer; begin Step := Random(2*r); if Odd(Step) then Step := -Step; X := X + Step; Step := Random(r); if Odd(Step) then Step := -Step; Y := Y + Step; { Make saucer bounce off viewport walls } with CurPort do begin if (x1 + X + Width - 1 > x2) then X := x2-x1 - Width + 1 else if (X < 0) then X := 0; if (y1 + Y + Height - 1 > y2) then Y := y2-y1 - Height + 1 else if (Y < 0) then Y := 0; end; end; { MoveSaucer } var Pausetime : word; Saucer : pointer; X, Y : integer; ulx, uly : word; lrx, lry : word; Size : word; I : word; begin ClearDevice; FullPort; { PaintScreen } ClearDevice; MainWindow('GetImage / PutImage Demonstration'); StatusLine('Esc aborts or press a key...'); GetViewSettings(CurPort); { DrawSaucer } Ellipse(StartX, StartY, 0, 360, r, (r div 3)+2); Ellipse(StartX, StartY-4, 190, 357, r, r div 3); Line(StartX+7, StartY-6, StartX+10, StartY-12); Circle(StartX+10, StartY-12, 2); Line(StartX-7, StartY-6, StartX-10, StartY-12); Circle(StartX-10, StartY-12, 2); SetFillStyle(SolidFill, MaxColor); FloodFill(StartX+1, StartY+4, GetColor); { ReadSaucerImage } ulx := StartX-(r+1); uly := StartY-14; lrx := StartX+(r+1); lry := StartY+(r div 3)+3; Size := ImageSize(ulx, uly, lrx, lry); GetMem(Saucer, Size); GetImage(ulx, uly, lrx, lry, Saucer^); { PutImage(ulx, uly, Saucer^, XORput); { erase image } { Plot some "stars" } for I := 1 to 1000 do PutPixel(Random(MaxX), Random(MaxY), RandColor); X := MaxX div 2; Y := MaxY div 2; PauseTime := 70; { Move the saucer around } repeat { PutImage(X, Y, Saucer^, XORput); { draw image } Delay(PauseTime); { PutImage(X, Y, Saucer^, XORput); { erase image } MoveSaucer(X, Y, lrx - ulx + 1, lry - uly + 1); { width/height } until KeyPressed; FreeMem(Saucer, size); WaitToGo; end; { PutImagePlay } procedure PolyPlay; { Draw random polygons with random fill styles on the screen } const MaxPts = 5; type PolygonType = array[1..MaxPts] of PointType; var Poly : PolygonType; I, Color : word; begin MainWindow('FillPoly demonstration'); StatusLine('Esc aborts or press a key...'); repeat Color := RandColor; SetFillStyle(Random(11)+1, Color); SetColor(Color); for I := 1 to MaxPts do with Poly[I] do begin X := Random(MaxX); Y := Random(MaxY); end; FillPoly(MaxPts, Poly); until KeyPressed; WaitToGo; end; { PolyPlay } procedure FillStylePlay; { Display all of the predefined fill styles available } var Style : word; Width : word; Height : word; X, Y : word; I, J : word; ViewInfo : ViewPortType; procedure DrawBox(X, Y : word); begin SetFillStyle(Style, MaxColor); with ViewInfo do Bar(X, Y, X+Width, Y+Height); Rectangle(X, Y, X+Width, Y+Height); OutTextXY(X+(Width div 2), Y+Height+4, Int2Str(Style)); Inc(Style); end; { DrawBox } begin MainWindow('Pre-defined fill styles'); GetViewSettings(ViewInfo); with ViewInfo do begin Width := 2 * ((x2+1) div 13); Height := 2 * ((y2-10) div 10); end; X := Width div 2; Y := Height div 2; Style := 0; for J := 1 to 3 do begin for I := 1 to 4 do begin DrawBox(X, Y); Inc(X, (Width div 2) * 3); end; X := Width div 2; Inc(Y, (Height div 2) * 3); end; SetTextJustify(LeftText, TopText); WaitToGo; end; { FillStylePlay } procedure FillPatternPlay; { Display some user defined fill patterns } const Patterns : array[0..11] of FillPatternType = ( ($AA, $55, $AA, $55, $AA, $55, $AA, $55 !BBx!!!BBx!BBx"""DDp""DDp>"""BBp""!"BDp>I|   @>00>> $< @p> BBBB< @@****DDDDDDDUUUUUUUwwwwwww;DDD; $"Bd>@@@>||>Ac]AAA1N"A""2, `1NA"*III*>xDDxDNDD <` <>BB= > """>0@@A>@@@ b$(. b$(*  $ $ $DDDDDDDUUUUUUUwwwwwww